home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue46 / Alfresco / AAFltStk.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-04-25  |  3.2 KB  |  125 lines
  1. {*********************************************************}
  2. {* AAFltStk                                              *}
  3. {* Copyright (c) Julian M Bucknall 1998-1999             *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Stack of floating point values (doubles)              *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AAFltStk;
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils;
  19.  
  20. type
  21.   TaaFloatStack = class
  22.     private
  23.       FStack : PChar;
  24.       FSP    : integer;
  25.       FSize  : integer;
  26.     protected
  27.     public
  28.       constructor Create;
  29.         {-create the double type stack}
  30.       destructor Destroy; override;
  31.         {-destroy the double type stack; releasing all memory}
  32.  
  33.       procedure Clear;
  34.         {-remove all doubles from stack}
  35.       function Count : integer;
  36.         {-count of doubles on the stack}
  37.       function Examine : double;
  38.         {-return the top double value from the stack; don't pop it}
  39.       function IsEmpty : boolean;
  40.         {-is the stack empty?}
  41.       function Pop : double;
  42.         {-pop the top double value from the stack; return it}
  43.       procedure Push(aValue : double);
  44.         {-push the given double onto the stack}
  45.     end;
  46.  
  47. implementation
  48.  
  49. type
  50.   PDouble = ^double;
  51.  
  52. {===TaaFloatStack====================================================}
  53. constructor TaaFloatStack.Create;
  54. begin
  55.   inherited Create;
  56.   FSize := 1024;
  57.   GetMem(FStack, FSize);
  58.   FSP := -1;
  59. end;
  60. {--------}
  61. destructor TaaFloatStack.Destroy;
  62. begin
  63.   if (FStack <> nil) then
  64.     FreeMem(FStack, FSize);
  65.   inherited Destroy;
  66. end;
  67. {--------}
  68. procedure TaaFloatStack.Clear;
  69. begin
  70.   FSP := -1;
  71. end;
  72. {--------}
  73. function TaaFloatStack.Count : integer;
  74. begin
  75.   Result := succ(FSP);
  76. end;
  77. {--------}
  78. function TaaFloatStack.Examine : double;
  79. begin
  80.   {check for the obvious mistake}
  81.   if (FSP = -1) then
  82.     raise Exception.Create('TaaFloatStack.Examine: the stack is empty');
  83.   {return the current character}
  84.   Result := PDouble(@FStack[FSP])^;
  85. end;
  86. {--------}
  87. function TaaFloatStack.IsEmpty : boolean;
  88. begin
  89.   Result := (FSP = -1);
  90. end;
  91. {--------}
  92. function TaaFloatStack.Pop : double;
  93. begin
  94.   {check for the obvious mistake}
  95.   if (FSP = -1) then
  96.     raise Exception.Create('TaaFloatStack.Pop: the stack is empty');
  97.   {return the current character}
  98.   Result := PDouble(@FStack[FSP])^;
  99.   {decrement the stack pointer}
  100.   dec(FSP, sizeof(double));
  101. end;
  102. {--------}
  103. procedure TaaFloatStack.Push(aValue : double);
  104. var
  105.   NewSize  : integer;
  106.   NewStack : PChar;
  107. begin
  108.   {increment the stack pointer}
  109.   inc(FSP, sizeof(double));
  110.   {if we've run out of space, reallocate the stack buffer}
  111.   if (FSP >= FSize) then begin
  112.     NewSize := FSize + 256;
  113.     GetMem(NewStack, NewSize);
  114.     Move(FStack^, NewStack^, FSize);
  115.     FreeMem(FStack, FSize);
  116.     FStack := NewStack;
  117.     FSize := NewSize;
  118.   end;
  119.   {store the pushed character}
  120.   PDouble(@FStack[FSP])^ := aValue;
  121. end;
  122. {====================================================================}
  123.  
  124. end.
  125.